The X-Philes (2nd Revision)/The X-Philes Number 1 (1995).iso/xphiles/hp48hor2/timer2.src

Text File | 1992-01-11 | 6KB | 276 lines

%%HP: T(3)A(D)F(.);
@ TIMER2.LIB's original directory
DIR
  $CONFIG
    \<< 799 ATTACH
    \>>
  $ROMID 799
  $TITLE
"TIMER.APPLICATIONS"
  $VARS { UM TS US
TSTART }
  $VISIBLE { TIM1
TIMER.COUNTDOWN
TSTART }
  CNTUP
    \<< GET.SEC \-> ss
ps
      \<< ps ss - 0
'UM' STO 10 / DUP
IP 'TS' STO FP 10 *
IP 'US' STO
        DO GET.SEC
\-> s
          \<<
            IF ps s
\=/
            THEN
'US' INCR s 'ps'
STO
              IF 9
>
              THEN
'US' 10 STO- 'TS'
INCR
IF 5 >
THEN 'TS' 6 STO-
'UM' INCR DROP DUP
(-3.4,3.2) NUMS.GRO
UM 1 + GET REPL
END DUP (.6,3.2)
NUMS.GRO TS 1 + GET
REPL
              END
DUP (3.5,3.2)
NUMS.GRO US 1 + GET
REPL
            ELSE
MEM DROP
            END
          \>>
        UNTIL
          IF KEY
          THEN 11
==
          ELSE 0
          END
        END 1000 .5
BEEP 2 WAIT
      \>>
    \>>
  COUNT2
    \<< GET.SEC \-> ps
      \<<
        DO GET.SEC
\-> s
          \<<
            IF ps s
\=/
            THEN
'US' DECR s 'ps'
STO
              IF 0
<
              THEN
'US' 10 STO+ 'TS'
DECR
IF 0 <
THEN 'TS' 6 STO+
'UM' DECR DROP DUP
(-3.4,3.2) NUMS.GRO
UM 1 + GET REPL
END DUP (.6,3.2)
NUMS.GRO TS 1 + GET
REPL
              END
DUP (3.5,3.2)
NUMS.GRO US 1 + GET
REPL
            ELSE
MEM DROP
            END
          \>>
        UNTIL US TS
UM + + 0 ==
          IF KEY
          THEN 11
==
          ELSE 0
          END OR
        END
        IF UM TS US
+ + 0 ==
        THEN CLEAR
PICT GET.SEC
          DO TONE
          UNTIL
            IF KEY
            THEN 11
==
            ELSE 0
            END
          END CNTUP
        ELSE 1000
.5 BEEP 2 WAIT
        END
      \>>
    \>>
  GET.SEC
    \<< TIME 100 * FP
100 * IP
    \>>
  IN&CK
    \<<
      DO 0 \-> ok
        \<< CLEAR
"COUNTDOWN TIMER
Enter Mins & Secs
 (i.e. 2:48 is 248)"
{ ":Time:0" { -1 7
} \Ga V } INPUT OBJ\->
DTAG
          IF DUP
'A' SAME
          THEN DROP
0
          END DUP
DUP 100 /
          IF IP DUP
9 >
          THEN
CLLCD
"Minutes are too
  Large"
500 .5 BEEP 1 DISP
2 WAIT CLLCD
          ELSE 'ok'
INCR DROP
          END 100 *
-
          IF 59 >
          THEN
CLLCD
"Seconds are too
  Large"
500 .5 BEEP 1 DISP
2 WAIT CLLCD
          ELSE 'ok'
INCR DROP
          END ok
        \>>
      UNTIL 2 ==
      END
      IF DUP 0 \=/
      THEN 'TSTART'
STO 1
      END
    \>>
  NUMS.GRO {
GROB 27 26 0EFFF3000FFFF7000FFFF7000FFFF7000F0087000F0087000F0087000F0087000F0087000F0087000F0087000F0087000F0087000F0087000F0087000F0087000F0087000F0087000F0087000F0087000F0087000F0087000FFFF7000FFFF7000FFFF7000EFFF300
GROB 27 26 000F0000008F000000CF000000EF000000FF000008FF0000000F0000000F0000000F0000000F0000000F0000000F0000000F0000000F0000000F0000000F0000000F0000000F0000000F0000000F0000000F0000000F00000EFFF7000EFFF7000EFFF7000EFFF700
GROB 27 26 0EFFF3000FFFF7000FFFF7000FFFF7000F0087000F00870000008700000087000000870000008700000087000EFFF7000FFFF7000FFFF7000FFFF3000F0000000F0000000F0000000F0000000F0000000F0000000F0000000FFFF7000FFFF7000FFFF7000EFFF700
GROB 27 26 0EFFF3000FFFF7000FFFF7000FFFF7000F0087000F008700000087000000870000008700000087000000870000FFF70000FFF70000FFF70000FFF70000008700000087000000870000008700000087000F0087000F0087000FFFF7000FFFF7000FFFF7000EFFF300
GROB 27 26 0F0087000F0087000F0087000F0087000F0087000F0087000F0087000F0087000F0087000F0087000F0087000FFFF7000FFFF7000FFFF7000EFFF7000000870000008700000087000000870000008700000087000000870000008700000087000000870000008700
GROB 27 26 0EFFF7000FFFF7000FFFF7000FFFF7000F0000000F0000000F0000000F0000000F0000000F0000000F0000000FFFF3000FFFF7000FFFF7000EFFF70000008700000087000000870000008700000087000F0087000F0087000FFFF7000FFFF7000FFFF7000EFFF300
GROB 27 26 0EFFF3000FFFF7000FFFF7000FFFF7000F0087000F0087000F0000000F0000000F0000000F0000000F0000000FFFF3000FFFF7000FFFF7000FFFF7000F0087000F0087000F0087000F0087000F0087000F0087000F0087000FFFF7000FFFF7000FFFF7000EFFF300
GROB 27 26 0EFFF3000FFFF7000FFFF7000FFFF7000F0087000F0087000000870000008700000087000000870000008700000087000000870000008700000087000000870000008700000087000000870000008700000087000000870000008700000087000000870000008700
GROB 27 26 0EFFF3000FFFF7000FFFF7000FFFF7000F0087000F0087000F0087000F0087000F0087000F0087000F0087000FFFF7000FFFF7000FFFF7000FFFF7000F0087000F0087000F0087000F0087000F0087000F0087000F0087000FFFF7000FFFF7000FFFF7000EFFF300
GROB 27 26 0EFFF3000FFFF7000FFFF7000FFFF7000F0087000F0087000F0087000F0087000F0087000F0087000F0087000FFFF7000FFFF7000FFFF7000EFFF70000008700000087000000870000008700000087000F0087000F0087000FFFF7000FFFF7000FFFF7000EFFF300
GROB 14 26 000000000000000000000000000000000C300C300C300C30000000000C300C300C300C3000000000000000000000000000000000
}
  SCREEN
    \<< PICT DUP
(3.5,3.2) NUMS.GRO
US 1 + GET REPL DUP
(.6,3.2) NUMS.GRO
TS 1 + GET REPL DUP
(-.7,3.2) NUMS.GRO
11 GET REPL DUP
(-3.4,3.2) NUMS.GRO
UM 1 + GET REPL MEM
DROP
    \>>
  SET.TM
    \<< TSTART 100 /
DUP IP SWAP FP 10 *
DUP IP SWAP FP 10 *
'US' STO 'TS' STO
'UM' STO
    \>>
  SETONE.TM
    \<< 1 0 0 'US'
STO 'TS' STO 'UM'
STO
    \>>
  STGO.KEY
    \<<
      DO -1 WAIT
      UNTIL DUP DUP
16.1 == SWAP 11.1
== OR
      END
    \>>
  TIM1
    \<< RCLMENU {
(-6.5,-3.1)
(6.5,3.2) X 0 (0,0)
FUNCTION Y } 'PPAR'
STO # 131d # 64d
PDIM ERASE { "STOP"
"" "" "" "" "GO" }
TMENU \-> pth
      \<< { # 0d # 0d
} PVIEW SETONE.TM
SCREEN STGO.KEY
        IF 16.1 ==
        THEN
          DO COUNT2
2 WAIT SETONE.TM
SCREEN
          UNTIL
STGO.KEY 16.1 \=/
          END
        END CLEAR {
UM TS US PPAR }
PURGE pth MENU
      \>>
    \>>
  TIMER.COUNTDOWN
    \<< RCLMENU {
(-6.5,-3.1)
(6.5,3.2) X 0 (0,0)
FUNCTION Y } 'PPAR'
STO # 131d # 64d
PDIM ERASE { "STOP"
"" "" "" "" "GO" }
TMENU TSTART
      IF DUP
'TSTART' SAME
      THEN DROP 100
      END 'TSTART'
STO \-> pth
      \<<
        DO { # 0d
# 0d } PVIEW TLOOP
        UNTIL NOT
        END CLEAR {
PPAR UM TS US }
PURGE pth MENU
      \>>
    \>>
  TLOOP
    \<< SET.TM SCREEN
STGO.KEY
      IF 16.1 ==
      THEN COUNT2 1
      ELSE IN&CK
      END
    \>>
  TONE
    \<< 1000 .5 BEEP
500 .5 BEEP .25
WAIT
    \>>
  TSTART 15
END